home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 38
/
038.d81
/
calendar maker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
4KB
|
147 lines
200 gosub60100:clr
210 dim d(42),mo$(12),m$(12,8),dm(12),fd(12)
220 for x = 1 to 12 : read mo$(x) : next
230 data january,february,march,april
240 data may,june,july,august,september
250 data october,november,december
260 for x = 1 to 12 : read dm(x) : next
270 data 31,28,31,30,31,30,31,31,30,31,30,31
280 for x = 1 to 12 : read fd(x) : next
290 data 0,3,3,-1,1,4,-1,2,5,0,3,5
300 sp$=" ":rem 24 spaces
310 dn$=" su mo tu we th fr sa "
320 dl$="---------------------":rem 21 dashes
330 print "[147] calendar maker "
335 print" by bruce jeager"
340 print
345 print"enter q [146] to quit."
350 print "enter starting year:";:gosub60500:y1=val(b$)
355 ifb$="q"thengosub60000:goto345
360 if y1<1752 then gosub 62000:goto 330
370 print
380 print "( return alone =" y1 ")"
390 y2=y1
400 print
410 print "enter ending year: [157][157][157][157][157]";:gosub60500:y2=val(b$):ifb$=""theny2=y1
411 ifb$="q"orb$="[209]" then 330
412 ifb$=""theny2=y1
415 ify2<y1 then gosub 62100:goto 410
420 if y2<1752 then gosub62000:goto330
425 gosub9000:ifnot(ok)thenrun210
430 print
440 print : print"calculating..."
450 close4 : open4,4
460 for yr = y1 to y2
470 print : printchr$(18)yr
480 z=(yr/100) : c=int(yr/100) : a=z-c
490 if a=0 then 530
500 z=(yr/4) : c=int(yr/4) : a=z-c
510 if a=0 then xd=1 : goto 560
520 goto 550
530 z=(yr/400) : c=int(yr/400) : a=z-c
540 if a=0 then xd=1 : goto 560
550 xd=0
560 f=int(yr/4) : g=int(yr/400) : h=int(yr/100)
570 j=f+g-h
580 l=(yr+j)/7 : m=int((yr+j)/7)
590 q=(l-m)*7 : ys=int(q) : r=q-ys
600 if r>0.9 then ys=ys+1
610 ys=ys-xd
620 if ys<0 then ys=ys+7
630 for mh=1 to 12
640 mn$=mo$(mh) : print left$(mn$+sp$,20);
650 dm = dm(mh) : if mh=2 then dm=dm+xd
660 fd=ys+fd(mh)+xd : if mh=1 then fd=ys
670 if mh=2 then fd=ys+3
680 if fd>6 then fd=fd-7
690 if fd<0 then fd=fd+7
700 w=20
710 yr=int(yr)
720 m$(mh,0)=left$(mn$+sp$,24)
730 m$(mh,1)=dn$
740 m$(mh,2)=dl$
745 for i=3to8:m$(mh,i)="":next
750 for x = 1 to 42 : d(x)=0 : next
760 y=1 : z=y : for x = fd+1 to 42 : d(x)=z
770 y=y+1 : z=y : if z>dm then z=0
780 next : we=0 : y=0
790 for x = 1 to 42 : y=y+1 : if y>6 then y=0
800 if d(x)=0 then m$(mh,we+3)=m$(mh,we+3)+" " : goto820
810 m$(mh,we+3) = m$(mh,we+3) + right$( " "+ str$(d(x)),3)
820 if y=0 then we=we+1
830 next x
840 next mh
850 print#4:print#4,yr
860 print#4:print#4:ln=4
870 for x = 0 to 12 : for y = 0 to 8
880 m$(x,y) = left$(m$(x,y)+sp$,24)
890 next y : next x
900 for x=0to8:print#4," "m$(1,x)m$(2,x)m$(3,x):next:print#4:print#4
910 for x=0to8:print#4," "m$(4,x)m$(5,x)m$(6,x):next:print#4:print#4
920 for x=0to8:print#4," "m$(7,x)m$(8,x)m$(9,x):next:print#4:print#4
930 for x=0to8:print#4," "m$(10,x)m$(11,x)m$(12,x):next:print#4:print#4
940 for x = 1 to 18 : print#4 : next
950 next yr : close4
960 run210
9000 ok=-1:open15,4,15:close15:ifst=.thenreturn
9010 ok=.:print" error: printer not online!"
9015 fora=1to50:poke54296,15:poke54296,.:next
9020 fora=1to3000:next:return
60000 print"[145][145] "
60010 print" are you sure you want to quit? (y/n)"
60020 a=peek(203):ifa<>25anda<>39then60020
60030 ifa=39thenprint"[145] [145][145]":return
60040 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
60050 ifer<>63thenend
60060 load"hello connect",8
60100 poke53280,1:poke53281,1
60110 printchr$(142)"[147][149][213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]";
60120 fora=1to23:print"[221]"spc(38)"[221]";:next
60130 print"[202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203][157][148][192]"
60140 fora=217to242:pokea,peek(a)or128:next
60150 print" loadstar presents:"
60160 print" "
60170 print" calendar maker [155] "
60180 print" [155] "
60190 print" by bruce jeager [155] "
60200 print" [155] "
60210 print" copyright 1987 [155] "
60220 print" [155] "
60230 print" "
60240 print" press space to continue"
60250 ifpeek(203)<>60then60250
60260 return
60500 b$="":print"[164]";:fora=1to5
60510 geta$:ifa$=""then60510
60520 ifa$=chr$(13)thenprint"[157] ":return
60530 ifa$=chr$(20)anda>1thenprint"[157][157] [157][157][164]";:a=a-1:b$=left$(b$,a-1):goto60510
60535 if(a=5)then60510
60540 ifa$="q"ora$="[209]"then60560
60550 ifa$<"0"ora$>"9"then60510
60560 print"[157]"a$"[164]";:b$=b$+a$:next
62000 print""
62010 print" "
62011 print" starting date [152] "
62012 print" should be larger [152] "
62015 print" than 1751 [152] "
62020 print" [152] "
62021 print" [152] "
62025 forx=1to2500:next
62030 return
62100 print""
62110 print" "
62111 print" ending date [152] "
62112 print" should be larger [152] "
62115 print" than "str$(y1)" [152] "
62120 print" [152] "
62121 print" [152] "
62125 forx=1to2500:next
62130 print""
62131 print" "
62132 print" "
62133 print" "
62134 print" "
62135 print" "
62136 print" "
62140 return